COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "PONY"	COMMENT
C00005 00003				COMMENT Useful Sail macros
C00010 00004				! Initialization
C00015 00005				! SCANNING PROCEDURES
C00020 00006				! OUTPUT PROCEDURES
C00025 00007				! DO IT
C00029 ENDMK
C⊗;
BEGIN "PONY"	COMMENT






		    Prancing Pony Point-of-sale Terminal

If you are a "local" user of our system you may charge food on this
terminal.  Example: if your programmer initials are "LEO" and you
want to buy a cup of coffee, type
  LEO C<return>

To buy two bagels, a donut, a 15 cent vending machine item, a 35 cent
vending machine item, and $1 in change, type
  LEO BB D V15 V35 M1.
In this case, it will open the .15 door first and wait for you to hit
<return> again before it opens the .35 door.

The complete list of item codes is:
C - Coffee, tea, hot chocolate
D - Donuts
B - Bagels
V - Vending machine
S - Snacks (munches, soup, etc.)
M - Money (stealing from the change box)

P - change your Password
T - show your Total changes for the month
I - Itemize your charges day-by-day.

The B, C, and D codes can be used without a number following, since their
prices are known to the machine.  For the V, S, and M codes the amount
must be specified.  You can also "uncharge" by specifying a negative
value.  For example,
  LEO -CCC M-25 V-35
credits your account for three cups of coffee, 25 cents in cash, and a
35 cent vending machine purchase, and arouses the suspicions of the
accounting program.

If you would like to know about charges for earlier months, use the "T" or
"I" command followed by ":" and 3 or more letters of the month name.
Thus if LEO were interested in totals for July and August and itemized
charges for September, he would type
  LEO T:JUL T:AUG I:SEP

Bon appetit!
;
			COMMENT Useful Sail macros;
REQUIRE "[]<>" DELIMITERS;
DEFINE TAB='11,LF='12,VT='13,FF='14,CR='15,ALT='175,DEL='177,↓=[(CR&LF)],
	!=[COMMENT], THRU=[STEP 1 UNTIL], LN=[LENGTH],PROC=[SIMPLE PROCEDURE];

DEFINE PMAX=[300],CMAX=[12];	! max people, charges/line;
DEFINE BILLFILE=[".PNY"],KEYFILE=["KEYWD"],DOORFILE=["DOORP"];

DEFINE TTYUUO=['051000000000], CALLI=['47000000000], VMICONO=['736600000000],
	MTAPE=['072000000000];

DEFINE LH(WORD)=[((WORD)land '777777000000)],RH(WORD)=[((WORD)land '777777)];

DEFINE SYMBRK=2;	! allocate and initialize break tables;
DEFINE BREAK_TABLE(STUFF)=[
	REDEFINE SYMBRK=SYMBRK+1,  ZZZ=[BREAK]&CVS(SYMBRK);
	IFCR SYMBRK>12 THENC REQUIRE "Too many break tables" MESSAGE; ENDC
	SIMPLE PROCEDURE ZZZ;  SETBREAK(SYMBRK,STUFF);
	REQUIRE ZZZ INITIALIZATION;
	];
DEFINE BREAK(ID,TERM,OMIT,MODES)= [
	BREAK_TABLE(<TERM,OMIT,MODES>);
	DEFINE ID=SYMBRK
	];
DEFINE SCNBRK(ID,TERM,OMIT,MODES)= [
	BREAK_TABLE(<TERM,OMIT,MODES>);
	DEFINE ID(S)=[SCAN(S,]&CVS(SYMBRK)&[,BRK)]
	];

DEFINE LETTERS=["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"];

DEFINE SAY(MES)=[OUT(TTY,MES)], INLINE=[INPUT(TTY,1)];

DEFINE TTY=[1],OUCH=[2];		! TTY I/O channel, DSK CHAN.;
INTEGER INCH,BRK,EOF,FLAG,TTYEOF;	! INPUT/OUTPUT GLOBALS;
STRING BLANKS;

STRING PROC ASK(STRING MES); BEGIN SAY(MES); RETURN(INLINE) END;

STRING PROC RIGHT(INTEGER L; STRING S);
	RETURN(IF LN(S)<L THEN BLANKS[1 TO L-LN(S)]&S  ELSE S[∞-L+1 TO ∞]);

STRING PROC DEC2(INTEGER D); RETURN(("0"+D%10)&("0"+D MOD 10));

STRING PROC CENTS(INTEGER P);  ! integer → $.cents;
	RETURN(if P=0 then "0" else
	(if abs P≥100 then cvs(P%100) else if P<0 then "-0" else null)&
	"."&DEC2(abs P mod 100));

INTEGER PROC SLURP(STRING MES);  BEGIN ! read a password;
	integer pass;
			! Turn off echo;
	START_CODE; GETSTS TTY,1; TRO 1,'600;	SETSTS TTY,(1); END;
	pass←cvsix(right(6,ask(mes)));
			! Turn on echo;
	START_CODE; GETSTS TTY,1; TRZ 1,'600; SETSTS TTY,(1); END;
	say(↓); return(pass)
	end "SLURP";

INTEGER PROC HASH(INTEGER SIXB); RETURN(RH(SIXB*SIXB));	! hash code;

PROC NOTICE(STRING MESS); BEGIN ! trouble in River City;
	SAY("πππ"); SAY(MESS); SAY(" -- PLEASE NOTIFY FRONT OFFICE"&↓);
	END;

PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP",
             "OCT","NOV","DEC";
STRING ARRAY MONTH[1:12];
			! Initialization;
PRELOAD_WITH CVSIX("GODMOD"),'15,0;
INTEGER ARRAY PNYPASS[0:3];		! master password block;
INTEGER ARRAY DOOR[0:9];		! vending machine charges;
INTEGER ARRAY PN[1:PMAX];		! PN,,password;
STRING ARRAY FRIEND[1:PMAX];		! friendly name;
boolean phantom;			! TRUE if this is a phantom;

INTEGER PTOP;				! last entry in PN;

SCNBRK(FLUSH,<" 	,;$+">,NULL,"XNR");	! FLUSH JUNK;
SCNBRK(SCALET,LETTERS,NULL,"XNR");	! GOBBLE LETTERS;
SCNBRK(NUMS,"0123456789.",<" 	,;$+">,"XNR");	! gobble number;
SCNBRK(DIGS,"0123456789",NULL,"XNR");	! gobble integer;

PROCEDURE TTYINIT;  BEGIN		! INIT TTY;
	OPEN(TTY,IF PHANTOM THEN "TTY4" ELSE "TTY",'401,1,1,400,BRK,TTYEOF);
	START_CODE	SETSTS TTY,1;	END;	! Repair TTY IOS;
	END;

PROCEDURE INITIAL;	BEGIN		! INITIALIZE THE WORLD;
	REQUIRE "PHONEY.SAI[1,LES]" SOURCE_FILE;
	INTEGER II,pnpa;
	LABEL FULL;

	procedure store;   if ptop<pmax then begin "store PN & friendly"
		pn[ptop←ptop+1]←cvsix(prog);
		friend[ptop]←friendly;
		end
	    else begin notice("Too many users");  go to full  end;

	BLANKS←"                          ";
	SETBREAK(1,LF,CR,"INS");
			! Pick a TTY;
	START_CODE SETOM II; TTYUUO 6,II;  END;
	PHANTOM←(II=-1);			! IF DETACHED, ITS A PHANTOM;
	TTYINIT;				! INIT TTY;
			! Open for accounting I/O;
	open(ouch,"dsk",'17,0,0,400,brk,eof);
			! Get PN list;
	ptop←0;
	while read do store;
	while class do store;
			! Read password file;
FULL:	open(inch←getchan,"dsk",'10,4,0,400,brk,eof);
	lookup(inch,keyfile,flag);
	if flag then notice("Can't read "&keyfile) else
	    while pnpa←wordin(inch) do if rh(pnpa) then begin "search"
		integer ps;
		ps←lh(pnpa);
		for ii←2 thru ptop do if ps=pn[ii] then begin
			pn[ii]←pnpa;	done
			end;
		end;
	close(inch);
			! Read VM prices;
	lookup(inch,doorfile,flag);
	if flag then notice("Can't read price file")
	    else arryin(inch,door[0],10);
	release(inch);
	end "INITIAL";
REQUIRE INITIAL INITIALIZATION;

PROCEDURE WRITEARR(STRING FILE;REFERENCE INTEGER A;INTEGER TOP); BEGIN
	enter(ouch,file,flag);
	if ¬flag then arryout(ouch,A,top) else
	    notice(file&" can't be written");
	close(ouch);
	END;
			! SCANNING PROCEDURES;
while true do begin "main"
LABEL START,FOUND;
string s,so;				! working string, original;
STRING VMQ,tiq,mon;			! VM queue, TI queue, month;
INTEGER DATE,TIME,DAY;			! current date, time, day;
INTEGER CI,NEG;				! # of charges, minus detected;
INTEGER ARRAY RECORD[1:128+CMAX*2];	! account buffer;
INTEGER ARRAY CHARGE[0:CMAX*2];		! PN,,day & code,,price;
INTEGER ID,PNI,TOT;			! Prog. ID, index, total bill;

PROC BARF(STRING MES);	BEGIN		! another try;
	say("πππ"); say(mes&↓); go to start
	end;

PROC ERROR; BARF(so[1 to ∞-ln(s)]&"?  Please retype the line");

BOOLEAN PROCEDURE MASTER(INTEGER SIXB);	BEGIN	! test master password;
	BOOLEAN MF;
	PNYPASS[3]←SIXB;
	LOOKUP(OUCH,"PNYSYS.UFD[1,1]",MF);
	IF MF THEN BEGIN CLOSE(OUCH); BARF("No [PNY,SYS] UFD"); END;
	START_CODE SETOM MF; MTAPE OUCH,PNYPASS[0]; SETZM MF END;
		! MTAPE skips if SIXB is the password;
	CLOSE(OUCH);  RETURN(MF)
	END "MASTER";

INTEGER PROC SCENT;  BEGIN ! convert price;
	integer i,j,k;
	string ss;
	if s="-" then neg←lop(s);
	i←cvd(digs(<ss←nums(s)>));
	if brk="." then begin "decimals"
		j←lop(ss);
		if ln(ss)=0 then i←100*i else 
		    if "0"≤(j←lop(ss))≤"9" ∧ "0"≤(k←lop(ss))≤"9" then
		    i←100*i+10*j+k-(10*"0"+"0") else error;
		end;
	if ln(ss) then error;
	return(if neg then -i else i)
	end "SCENT";

PROC BILL(INTEGER CODE,AMT); BEGIN	! write the bill;
	if ci≥cmax then barf("Line too long");
	charge[ci]←ID lor day;
	charge[ci+1]←cvsix(code) lor rh(amt);
	ci←ci+2;  tot←tot+amt;
	end;
	
PROC CHECK(INTEGER CODE,PRICE); BEGIN	! see if its a multiple of base price;
	integer pi;
	if (pi←scent)=0 ∨ (pi mod price)≠0 then
	    barf(""""&code&""" price must be a multiple of "¢s(price));
	BILL(CODE,pi);
	END;

PROC POOT(INTEGER CODE,PRICE); BEGIN
	integer pi,pj;
	if s= code then begin "string"
		pi←price;
		do begin
			pi←pi+price; pj←lop(s); flush(s);
			end
		    until s≠code;
		if neg then pi←-pi;
		end "string"
	    else begin "price"
		string ps;
		pj←neg;  ps←s;			! save the word;
		if (pi←scent)=0 then begin "nonum"
			pi←if (neg←pj) then -price else price;
			s←ps;			! restore it;
			end
		    else if (pi mod price)≠0 then
		    barf(""""&code&""" price must be a multiple of "&
		    cents(price));
		end "price";
	bill(code,pi);
	END "POOT";

PROC VENDI; BEGIN
	integer va,vi,vj;
	if va←abs(vi←scent) then
	    for vj←0 thru 9 do if va=door[vj] then begin "gotcha"
		if vi>0 then vmq←vmq&vj;  ! put it on the VM queue;
		bill("V",vi);			! & bill it;
		return
		end;
	barf("The vending machine doesn't have a "¢s(va)&" door");
	END;

INTEGER PROC TOTE;		! this month, or earlier? ;
	if s≠":" then return((date div 31)mod 12 + 1) else begin "earlier"
		integer ti;  string ts;
		ti←lop(s); flush(s);	! get to month name;
		ts←scalet(s);  ts←ts[1 to 3];	! take first 3 letters;
		for ti←1 thru 12 do if equ(ts,month[ti]) then return(ti);
		barf(ts&" isn't a month");
		end;
			! OUTPUT PROCEDURES;
PROCEDURE FIXPASS;	WHILE TRUE DO BEGIN	! NULLIFY PASSWORDS;
	label more;
	integer fpn,fi;
MORE:
	if (fpn←cvsix(ask("PN=")))=0 then begin
		writearr(keyfile,pn[1],ptop); return
		end;
	for fi←1 step 1 until ptop do if fpn=lh(pn[fi]) then
	    begin pn[fi]←fpn; go to more end;
	say("No such guy"&↓);
	END;

PROCEDURE NEWPRICE;	BEGIN	! change VM prices;
	integer ni;
	say("BAR PRICE"&↓);	! first, print the old prices;
	for ni←0 thru 9 do say(<cvs(ni)&right(5,cents(door[ni]))&↓>);
	while ln(s←ask("*")) do if 0≤(ni←LOP(s)-"0")≤9 then begin "examine"
		if ln(s) then begin
			if s≠" " then begin say("?"&↓); continue end;
			flush(s);  neg←0;  door[ni]←scent;
			end
		    else say(<right(6,cents(door[ni]))&↓>);
		end
	    else say("?"&↓);
	writearr(doorfile,door[0],10);
	END;

PROCEDURE SAVIT;	BEGIN			! update charge file;
	integer array data[0:5];
	integer bn,si;				! block #, word #;
	lookup(ouch,mon&billfile,flag);
	if flag then begin bn←1; si←0; end else begin "read file"
		fileinfo(data);
		si ← -(data[3] rot 18);  bn ← si%128 + 1;
		si←si mod 128;
		if si then begin
			useti(ouch,bn); arryin(ouch,record[1],si)
			end;
		end;
	arrblt(record[si+1],charge[0],ci);	! add the new entries;
	enter(ouch,mon&billfile,flag);
	if flag then notice("Cannot write "&mon&billfile);
	useto(ouch,bn);
	arryout(ouch,record[1],si+ci);
	close(ouch);
	END "SAVIT";

PROC VENDOUT;	BEGIN	! OPEN VM DOORS;
	integer vi,vd;
	vi←((vd←lop(vmq)) lsh 4) xor '370;
	start_code calli '400005; vmicono @vi; calli '400006 end;
	if ln(vmq) then ask(cents(door[vd])&" door open.  Hit return for next one");
	END;

PROCEDURE TOTAL;	BEGIN
	DEFINE CODES=["VCDBSM"];
	INTEGER ARRAY SUBTOT[1:LN(CODES)];
	integer w1,w2,cod,val,ti,dayn;
	BOOLEAN itemize;
	string ts,mont;

	itemize←(ti←lop(tiq))land '40;		! itemize≠0 means itemize;
	open(inch←getchan,"dsk",'10,4,0,400,brk,eof);
	lookup(inch,(mont←month[ti land '37])&billfile,flag);
	if flag then begin say(↓&"No data for "&mont&↓); return end;
	if itemize then begin dayn←0;  say(↓&"DATE    CHARGES FOR "&mont); end;
	while w1←wordin(inch) do begin	"SUM"	! PN,,day;
		label more;
		w2←wordin(inch);		! code,,value;
		if lh(w1)=ID then begin "his own"
			if itemize ∧ (val←rh(w1))≠dayn then
			    say(↓&right(2,cvs(dayn←val)));
			cod←(w2 lsh-30)+'40;	! ASCII code;
			if (val←rh(w2))land '400000 then
			    val←val lor '777777000000;	! integer value (+-);
			for ti←1 thru ln(codes) do if cod=codes[ti for 1]
			    then begin
				subtot[ti]←subtot[ti]+val;
				if itemize then say(" "&cod&cvs(val));
				go to more
				end;
			notice("Garbage in the accounting files");
			end "his own";
MORE:		end "SUM";
	release(inch);
	val←0;  ts←null;
	for ti←1 thru ln(codes) do if w1←subtot[ti] then begin "subtotals"
		val←val+w1;
		ts←ts&" "&codes[ti for 1]¢s(w1);
		end;
	say(↓&"Total for "&mont&": $"¢s(val)&" = "&ts&↓);
	END "TOTAL";
			! DO IT;
	BOOLEAN NEWPASSP,newpricep; ! new password, total requested;
	integer mc,key;

PROCEDURE NIX(BOOLEAN BAZ);	IF BAZ THEN SAY(<"πππSORRY, CHARLIE"&↓>) ELSE
    BARF("FOO, YOU ARE A PASSWORD HACKER!");

START:
	VMQ←TIQ←NULL;			! clear for new entry;
	CI←NEWPASSP←NEWPRICEP←tot←0;

	do begin "read"
		flush(<S←ask(↓&"EAT! ")>);		! get PN & command;
		if ttyeof then begin release(tty); ttyinit end;	! fix end-of-file;
		end
	    until ln(s);

	time←call(0,"timer")%3600;		! time since midnight in mins.;
	day←(date←call(0,"date"))mod 31 +1;	! date in system format;
	mon←month[(date div 31)mod 12 +1];
	if(id←cvsix(scalet(s)))=cvsix("SYS") then begin "master mode"
		flush(s);  so←s;
		while mc←lop(s) do begin
			if mc="P" then newpassp←true else
			    if mc="V" then newpricep←true else error;
			flush(s);
			end;
		while ¬master(mc←slurp("PASSWORD=")) do NIX(MC);
		if newpassp then fixpass;	! nullify passords;
		if newpricep then newprice;
		go to start
		end;
	for pni←1 thru ptop do if id=lh(key←pn[pni]) then go to found;
	barf("Sorry, I don't know you");
FOUND:
	flush(s);  so←s;
	while ln(s) do begin "decode"
		if neg←(mc←lop(s))="-" then begin flush(s); mc←lop(s) end;
		flush(s);
		if mc="P" then newpassp←true else
		    if mc="B" then poot("B",15) else
		    if mc="C" then poot("C",10) else
		    if mc="D" then poot("D",20) else
		    if mc="V" then vendi else
		    if mc="S" then check("S",5) else
		    if mc="M" then check("M",1) else
		    if mc="T" then tiq←tiq&tote else
		    if mc="I" then tiq←tiq&(tote lor '40) else error;
		flush(s);
		end "decode";
if ¬(key←rh(key)) then say("PASSWORD="&↓) else
    while hash(mc←slurp("PASSWORD="))≠key do nix(mc);

if newpassp then begin "newpass"	! enter new password;
	pn[pni]←lh(pn[pni]) lor hash(slurp("NEW PASSWORD="));
	WRITEARR(keyfile,pn[1],ptop);	! write out password file;
	END;
if ci then savit;			! write billing file;
if phantom then while ln(vmq) do vendout;	! activate VM;
if ci then say(<friend[pni]&" ate "¢s(tot)&" on "&cvs(date%(31*12)+1964)&
    " "&mon&" "&cvs(day)&" "&cvs(time%60)&":"&dec2(time mod 60)&↓>);
while ln(tiq) do total;		! show itemization or totals for month;
end "main"
end "PONY"